home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 051-060 / amok52 / gadgeted / txt / gadgets.mod < prev    next >
Text File  |  1993-11-04  |  22KB  |  778 lines
  1. (*----------------------------------------------------------------------
  2.   :Program.    Gadgets.mod
  3.   :Contents.   Aufbau und Verwaltung von Gadgets
  4.   :Author.     Hubert Bildstein
  5.   :Address.    Gehenbühlstr.5, W7000 Stuttgart 31, Germany
  6.   :Copyright.  Public Domain
  7.   :Language.   Modula-2
  8.   :Translator. M2Amiga V3.3d
  9.   :History.    V1.0   6.12.1990
  10.   :Remark.     Evtl. Namensgleichheit mit schon vorhandenen Modulen
  11.   :Remark.     ist zufällig
  12. ----------------------------------------------------------------------*)
  13.  
  14. IMPLEMENTATION MODULE Gadgets;
  15.  
  16. (*--------------------------------------------------------------------------*)
  17. (* Prozeduren zur Behandlung von String- und BooleanGadgets                 *)
  18. (*                                                                          *)
  19. (* Datum: 26.07.90                   letzte Änderung: 06.12.1990            *)
  20. (* Autor: Hubert Bildstein                                                  *)
  21. (* Compiler: M2Amiga V3.3d                                                  *)
  22. (*--------------------------------------------------------------------------*)
  23.  
  24. FROM SYSTEM      IMPORT ADR, ADDRESS;
  25. FROM ASCII       IMPORT nul;
  26. FROM Conversions IMPORT ValToStr;
  27. FROM Exec        IMPORT GetMsg, ReplyMsg, WaitPort;
  28. FROM Graphics    IMPORT jam1, jam2;
  29. FROM Intuition   IMPORT GadgetPtr, WindowPtr, GadgetFlagSet,GadgetFlags,
  30.                         ActivationFlagSet,ActivationFlags,
  31.                         IDCMPFlagSet, IDCMPFlags,
  32.                         Gadget,strGadget,boolGadget,propGadget,Border,
  33.                         BorderPtr,IntuiText,IntuiTextPtr,StringInfo,PropInfo,
  34.                         PropInfoFlagSet, PropInfoFlags,
  35.                         AddGadget, RemoveGadget, RefreshGadgets,
  36.                         IntuiMessagePtr, StringInfoPtr;
  37. FROM Storage     IMPORT ALLOCATE, DEALLOCATE;
  38. FROM Str         IMPORT Copy, Length;
  39.  
  40. CONST MaxString     = 255;
  41.       MaxPropSteps  = 65535;
  42.  
  43. TYPE StrType = ARRAY [0..MaxString] OF CHAR;
  44.      StrTypePtr = POINTER TO StrType;
  45.  
  46.      StrGadgetType = RECORD
  47.                       GadgetRecord : Gadget;
  48.                       Info         : StringInfo;
  49.                       Buffer       : StrType;
  50.                     END; (*RECORD*)
  51.      StrGadgetTypePtr = POINTER TO StrGadgetType;
  52.  
  53.      BoolGadgetType = RECORD
  54.                        GadgetRecord : Gadget;
  55.                      END; (*RECORD*)
  56.      BoolGadgetTypePtr = POINTER TO BoolGadgetType;
  57.  
  58.      PropGadgetType = RECORD
  59.                        GadgetRecord : Gadget;
  60.                        Info         : PropInfo;
  61.                        Rahmen       : Border;
  62.                      END; (*RECORD*)
  63.      PropGadgetTypePtr = POINTER TO PropGadgetType;
  64.  
  65. VAR WPtr : WindowPtr;       (* enthält Zeiger auf Window, mit dem gearbeitet
  66.                                werden soll *)
  67.     UBuffer : StrType;      (* allgemeiner Undo-Buffer für String-Gadgets *)
  68.  
  69. (*--------------------------------------------------------------------------*)
  70.  
  71. PROCEDURE DefineWindow (GWindow : WindowPtr);
  72. (* Arbeitswindow festlegen *)
  73.  
  74. BEGIN
  75.  
  76.  WPtr := GWindow;
  77.  
  78. END DefineWindow;
  79.  
  80. (*--------------------------------------------------------------------------*)
  81.  
  82. PROCEDURE MakeStrGadget (VAR GPtr      : GadgetPtr;
  83.                              GadgID    : INTEGER;
  84.                              x, y      : INTEGER;
  85.                              w, h      : INTEGER;
  86.                              MaxChars  : INTEGER;
  87.                              Flags     : GadgetFlagSet;
  88.                              AFlags    : ActivationFlagSet;
  89.                          VAR ok        : BOOLEAN);
  90.  
  91. (* Aufbau eines Stringgadgets, Darstellung im angegebenen Window *)
  92.  
  93. VAR Ptr             : StrGadgetTypePtr;
  94.     Pos             : INTEGER;
  95.  
  96. BEGIN
  97.  
  98.  (* Parameter sinnvoll? *)
  99.  IF (GadgID<0) OR (x<0) OR (y<0) OR (w<0) OR (MaxChars<1) OR
  100.     (MaxChars > MaxString) OR (WPtr = NIL)
  101.  THEN
  102.     GPtr := NIL;
  103.     ok := FALSE;
  104.     RETURN;
  105.  END; (*IF*)
  106.  
  107.  (* Speicher belegen: *)
  108.  ALLOCATE (Ptr,SIZE(StrGadgetType));
  109.  
  110.  (* Gadgetinformationen eintragen: *)
  111.  (*--------------------------------*)
  112.  
  113.  (* Gadget - Record *)
  114.  WITH Ptr^.GadgetRecord DO
  115.      nextGadget := NIL;
  116.      leftEdge := x; topEdge := y; width := w; height := h;
  117.      flags := Flags; activation := AFlags;
  118.      gadgetType := strGadget;
  119.      gadgetRender := NIL; selectRender := NIL; gadgetText := NIL;
  120.      specialInfo := ADR(Ptr^.Info);
  121.      gadgetID := GadgID; userData := NIL;
  122.  END; (*WITH*)
  123.  
  124.  Ptr^.Buffer := nul;
  125.  
  126.  (* StringInfo - Record *)
  127.  WITH Ptr^.Info DO
  128.     buffer := ADR(Ptr^.Buffer);
  129.     undoBuffer := ADR(UBuffer);
  130.     bufferPos := 0; maxChars := MaxChars;
  131.     dispPos := 0; longInt := 0;
  132.  END; (*WITH*)
  133.  
  134.  (* GadgetPtr ermitteln *)
  135.  GPtr := ADR(Ptr^.GadgetRecord);
  136.  
  137.  (* Gadget in Window einbauen: *)
  138.  Pos := AddGadget (WPtr,GPtr,0);
  139.  
  140.  (* Darstellen *)
  141.  RefreshGadgets (GPtr,WPtr,NIL);
  142.  
  143.  ok := TRUE;
  144.  
  145. END MakeStrGadget;
  146.  
  147. (*--------------------------------------------------------------------------*)
  148.  
  149. PROCEDURE MakeBoolGadget (VAR GPtr     : GadgetPtr;
  150.                               GadgID   : INTEGER;
  151.                               x, y     : INTEGER;
  152.                               w, h     : INTEGER;
  153.                               Flags    : GadgetFlagSet;
  154.                               AFlags   : ActivationFlagSet;
  155.                           VAR ok       : BOOLEAN);
  156. (* Boolean-Gadget erstellen und im Window darstellen *)
  157.  
  158. VAR Ptr             : BoolGadgetTypePtr;
  159.     Pos             : INTEGER;
  160.  
  161. BEGIN
  162.  
  163.  (* Parameter sinnvoll? *)
  164.  IF (GadgID<0) OR (x<0) OR (y<0) OR (w<0) OR (h<0) OR (WPtr = NIL) THEN
  165.     GPtr := NIL;
  166.     ok := FALSE;
  167.     RETURN;
  168.  END; (*IF*)
  169.  
  170.  (* Speicher belegen: *)
  171.  ALLOCATE (Ptr,SIZE(BoolGadgetType));
  172.  
  173.  (* Gadgetinformationen eintragen: *)
  174.  (*--------------------------------*)
  175.  
  176.  (* Gadget - Record *)
  177.  WITH Ptr^.GadgetRecord DO
  178.      nextGadget := NIL;
  179.      leftEdge := x; topEdge := y; width := w; height := h;
  180.      flags := Flags; activation := AFlags;
  181.      gadgetType := boolGadget;
  182.      gadgetRender := NIL; selectRender := NIL; gadgetText := NIL;
  183.      specialInfo := NIL;
  184.      gadgetID := GadgID; userData := NIL;
  185.  END; (*WITH*)
  186.  
  187.  (* GadgetPtr zurückgeben *)
  188.  GPtr := ADR(Ptr^.GadgetRecord);
  189.  
  190.  (* Gadget in Window einbauen: *)
  191.  Pos := AddGadget (WPtr,GPtr,0);
  192.  
  193.  (* Darstellen *)
  194.  RefreshGadgets (GPtr,WPtr,NIL);
  195.  
  196.  ok := TRUE;
  197.  
  198. END MakeBoolGadget;
  199.  
  200. (*--------------------------------------------------------------------------*)
  201.  
  202. PROCEDURE MakePropGadget (VAR GPtr    : GadgetPtr;
  203.                               GadgID  : INTEGER;
  204.                               x, y    : INTEGER;
  205.                               w, h    : INTEGER;
  206.                               AFlags  : ActivationFlagSet;
  207.                               Type    : PropTypeSet;
  208.                               HSteps  : CARDINAL;
  209.                               VSteps  : CARDINAL;
  210.                           VAR ok      : BOOLEAN);
  211. (* Erzeugt ein Proportional-Gadget im angegebenen Window *)
  212.  
  213. VAR Ptr     : PropGadgetTypePtr;
  214.     Pos     : INTEGER;
  215.     PFlags  : PropInfoFlagSet;
  216.  
  217. BEGIN
  218.  
  219.  (* Parameter sinnvoll? *)
  220.  IF (GadgID<0) OR (x<0) OR (y<0) OR (w<0) OR (h<0) OR
  221.     (Type = PropTypeSet{}) OR (WPtr = NIL) THEN
  222.     GPtr := NIL;
  223.     ok := FALSE;
  224.     RETURN;
  225.  END; (*IF*)
  226.  
  227.  (* Speicher belegen: *)
  228.  ALLOCATE (Ptr,SIZE(PropGadgetType));
  229.  
  230.  (* Gadgetinformationen eintragen: *)
  231.  (*--------------------------------*)
  232.  
  233.  (* Gadget - Record *)
  234.  WITH Ptr^.GadgetRecord DO
  235.      nextGadget := NIL;
  236.      leftEdge := x; topEdge := y; width := w; height := h;
  237.      flags := GadgetFlagSet{}; activation := AFlags;
  238.      gadgetType := propGadget; gadgetRender := ADR(Ptr^.Rahmen);
  239.      selectRender := NIL; gadgetText := NIL;
  240.      specialInfo := ADR(Ptr^.Info);
  241.      gadgetID := GadgID; userData := NIL;
  242.  END; (*WITH*)
  243.  
  244.  (* Typ des Gadgets auswerten *)
  245.  PFlags := PropInfoFlagSet{autoKnob};
  246.  IF (Horiz IN Type) THEN
  247.      INCL (PFlags,freeHoriz);
  248.  END; (*IF*)
  249.  IF (Vert IN Type) THEN
  250.      INCL (PFlags,freeVert);
  251.  END; (*IF*)
  252.  
  253.  (* PropInfo - Record *)
  254.  WITH Ptr^.Info DO
  255.      flags := PFlags;
  256.      horizPot := 0; vertPot := 0;
  257.      IF (HSteps <= 1) THEN
  258.         horizBody := MaxPropSteps;
  259.      ELSE
  260.         horizBody := MaxPropSteps DIV HSteps + 1;
  261.      END; (*IF*)
  262.      IF (VSteps <= 1) THEN
  263.         vertBody := MaxPropSteps;
  264.      ELSE
  265.         vertBody := MaxPropSteps DIV VSteps + 1;
  266.      END; (*IF*)
  267.  END; (*WITH*)
  268.  
  269.  (* Rahmen, Inhalt wird ignoriert, muß aber vorhanden sein! *)
  270.  WITH Ptr^.Rahmen DO
  271.      leftEdge := -1; topEdge := -1; frontPen := 1; backPen := 0;
  272.      drawMode := jam1;
  273.      count := 0; xy := NIL;   (* Rahmen wird automatisch gezeichnet *)
  274.      nextBorder := NIL;
  275.  END; (*WITH*)
  276.  
  277.  (* GadgetPtr zurückgeben *)
  278.  GPtr := ADR(Ptr^.GadgetRecord);
  279.  
  280.  (* Gadget in Window einbauen: *)
  281.  Pos := AddGadget (WPtr,GPtr,0);
  282.  
  283.  (* Darstellen *)
  284.  RefreshGadgets (GPtr,WPtr,NIL);
  285.  
  286.  ok := TRUE;
  287.  
  288. END MakePropGadget;
  289.  
  290. (*--------------------------------------------------------------------------*)
  291.  
  292. PROCEDURE WaitForGadget (VAR class : IDCMPFlagSet;
  293.                          VAR ID    : INTEGER;
  294.                          VAR GPtr  : GadgetPtr);
  295. (* Warten auf Message vom Window, evtl. wird Nummer des aktivierten Gadgets
  296.    zurückgegeben, sonst -1 *)
  297.  
  298. VAR IMsg : IntuiMessagePtr;
  299.  
  300. BEGIN
  301.  
  302.  IF (WPtr # NIL) THEN
  303.  
  304.       WaitPort (WPtr^.userPort);
  305.       IMsg := GetMsg (WPtr^.userPort);
  306.  
  307.       class := IMsg^.class;
  308.       IF (gadgetUp IN class) OR (gadgetDown IN class) THEN
  309.            GPtr := IMsg^.iAddress;
  310.            ID := GPtr^.gadgetID;
  311.       ELSE
  312.            ID := -1;
  313.       END; (*IF*)
  314.       ReplyMsg (IMsg);
  315.  
  316.  ELSE
  317.   class := IDCMPFlagSet{}; ID := -1; GPtr := NIL;
  318.  END; (*IF*)
  319.  
  320. END WaitForGadget;
  321.  
  322. (*--------------------------------------------------------------------------*)
  323.  
  324. (* Typen für Text *)
  325. TYPE TextType = RECORD
  326.                   iTextRecord : IntuiText;
  327.                   textString  : StrType;
  328.                 END; (*RECORD*)
  329.      TextTypePtr = POINTER TO TextType;
  330.  
  331.  
  332. PROCEDURE GadgetText (GPtr       : GadgetPtr;
  333.                       relX, relY : INTEGER;
  334.                       Text       : ARRAY OF CHAR;
  335.                       fPen, bPen : INTEGER);
  336.  
  337. (* Versieht ein Gadget mit einem Text *)
  338.  
  339. VAR Ptr     : TextTypePtr;
  340.     GText   : IntuiTextPtr;
  341.     TextPtr : StrTypePtr;
  342.     Dummy   : ADDRESS;
  343.  
  344. BEGIN
  345.  
  346.  IF (WPtr = NIL) OR (GPtr = NIL) THEN RETURN END;
  347.  
  348.  IF (HIGH(Text) >= MaxString) THEN   (* Text zu lang? *)
  349.     Text[MaxString] := nul;
  350.  END; (*IF*)
  351.  
  352.  IF (GPtr^.gadgetText # NIL) THEN     (* Text bereits vorhanden? *)
  353.  
  354.     GText := GPtr^.gadgetText;
  355.     TextPtr := GText^.iText;
  356.  
  357.  ELSE
  358.  
  359.     ALLOCATE (Ptr, SIZE(TextType));   (* Speicher holen *)
  360.     Dummy := Ptr;
  361.     GText := Dummy;
  362.     TextPtr := ADR(Ptr^.textString);
  363.  
  364.  END; (*IF*)
  365.  
  366.  Copy (TextPtr^,Text);
  367.  
  368.  WITH GText^ DO
  369.     frontPen := fPen;
  370.     backPen := bPen;
  371.     drawMode := jam2;
  372.     leftEdge := relX; topEdge := relY;
  373.     iTextFont := NIL;
  374.     iText := TextPtr;
  375.     nextText := NIL;
  376.  END; (*WITH*)
  377.  
  378.  (* Text anhängen *)
  379.  GPtr^.gadgetText := GText;
  380.  
  381.  
  382.  (* Gadget neu zeichnen *)
  383.  RefreshGadgets (GPtr, WPtr, NIL);
  384.  
  385.  
  386. END GadgetText;
  387.  
  388. (*--------------------------------------------------------------------------*)
  389.  
  390. PROCEDURE DeleteText (GPtr : GadgetPtr);
  391. (* Löschen des Gadget-Textes *)
  392.  
  393. VAR GText   : IntuiTextPtr;
  394.  
  395. BEGIN
  396.  
  397.  IF (WPtr # NIL) AND (GPtr # NIL) THEN
  398.    GText := GPtr^.gadgetText;
  399.    IF (GText # NIL) THEN
  400.       DEALLOCATE (GText, SIZE(TextType));  (* muß mit GadgetText erstellt *)
  401.       GPtr^.gadgetText := NIL;             (* worden sein! *)
  402.    END; (*IF*)
  403.  END; (*IF*)
  404.  
  405. END DeleteText;
  406.  
  407. (*--------------------------------------------------------------------------*)
  408.  
  409. (* Typen für Rahmen *)
  410. TYPE BorderArray = ARRAY [0..9] OF INTEGER;
  411.      BorderType = RECORD
  412.                    GadgetBorder : Border;
  413.                    XY           : BorderArray;
  414.                   END; (*RECORD*)
  415.      BorderTypePtr = POINTER TO BorderType;
  416.  
  417.  
  418. PROCEDURE GadgetBorder (GPtr         : GadgetPtr;
  419.                         relX, relY   : INTEGER;
  420.                         w, h         : INTEGER;
  421.                         Double       : BOOLEAN;
  422.                         xDist, yDist : INTEGER;
  423.                         Colour       : INTEGER);
  424. (* versieht Gadget mit einem einfachen/doppelten Rahmen *)
  425.  
  426. VAR RPtr1, RPtr2 : BorderTypePtr;
  427.     BPtr         : BorderPtr;
  428.     Dummy        : ADDRESS;
  429.  
  430. BEGIN
  431.  
  432.  IF (WPtr = NIL) OR (GPtr = NIL) THEN RETURN END;
  433.  
  434.  IF (GPtr^.gadgetRender = NIL) THEN    (* Schon Rahmen vorhanden? *)
  435.  
  436.     (* Speicher reservieren *)       (* nein, also neu belegen *)
  437.     ALLOCATE (RPtr1,SIZE(BorderType));
  438.     IF (Double) THEN
  439.        ALLOCATE (RPtr2,SIZE(BorderType));
  440.     END; (*IF*)
  441.  
  442.  ELSE     (* Rahmen bereits vorhanden *)
  443.  
  444.     RPtr1 := GPtr^.gadgetRender;   (* vorhandenen Rahmen übernehmen *)
  445.     (* VORSICHT! Vorhandener Rahmen muß auch schon von GadgetBorder erzeugt
  446.        worden sein! *)
  447.     BPtr := GPtr^.gadgetRender;
  448.  
  449.     IF (Double) AND (BPtr^.nextBorder = NIL) THEN
  450.         ALLOCATE (RPtr2,SIZE(BorderType));
  451.     ELSIF (Double) AND (BPtr^.nextBorder # NIL) THEN
  452.         Dummy := BPtr^.nextBorder;       (* VORSICHT! s.o. *)
  453.         RPtr2 := Dummy;
  454.     END; (*IF*)
  455.  
  456.  END; (*IF*)
  457.  
  458.  (* Werte eintragen: *)
  459.  WITH RPtr1^.GadgetBorder DO
  460.      leftEdge := relX; topEdge := relY;
  461.      frontPen := Colour; backPen := 0;
  462.      drawMode := jam1;
  463.      count := 5; xy := ADR(RPtr1^.XY);
  464.      IF (Double) THEN
  465.         nextBorder := ADR(RPtr2^.GadgetBorder);
  466.      ELSE
  467.         nextBorder := NIL;
  468.      END; (*IF*)
  469.  END; (*WITH*)
  470.  
  471.  (* Rahmenkoordinaten *)
  472.  WITH RPtr1^ DO
  473.      XY[0] := 0; XY[1] := 0; XY[2] := w; XY[3] := 0;
  474.      XY[4] := w; XY[5] := h; XY[6] := 0; XY[7] := h;
  475.      XY[8] := 0; XY[9] := 0;
  476.  END; (*WITH*)
  477.  
  478.  IF (Double) THEN
  479.  
  480.     WITH RPtr2^.GadgetBorder DO
  481.        leftEdge := relX-xDist; topEdge := relY-yDist;
  482.        frontPen := Colour; backPen := 0;
  483.        drawMode := jam1;
  484.        count := 5; xy := ADR(RPtr2^.XY);
  485.        nextBorder := NIL;
  486.     END; (*WITH*)
  487.  
  488.     (* Rahmenkoordinaten: *)
  489.     WITH RPtr2^ DO
  490.        XY[0] := 0; XY[1] := 0; XY[2] := w+2*xDist; XY[3] := 0;
  491.        XY[4] := w+2*xDist; XY[5] := h+2*yDist;
  492.        XY[6] := 0; XY[7] := h+2*yDist;
  493.        XY[8] := 0; XY[9] := 0;
  494.     END; (*WITH*)
  495.  
  496.  END; (*IF*)
  497.  
  498.  (* Rahmen dem Gadget anfügen *)
  499.  GPtr^.gadgetRender := RPtr1;
  500.  
  501.  (* Gadget neu zeichnen *)
  502.  RefreshGadgets (GPtr, WPtr, NIL);
  503.  
  504. END GadgetBorder;
  505.  
  506. (*--------------------------------------------------------------------------*)
  507.  
  508. PROCEDURE DeleteBorder (GPtr : GadgetPtr);
  509. (* Löschen des GadgetBorders *)
  510.  
  511. (*--------------------------------------*)
  512. PROCEDURE DelBorder (BPtr : BorderPtr);   (* rekursiv löschen *)
  513. BEGIN
  514.  IF (BPtr # NIL) THEN
  515.     DelBorder (BPtr^.nextBorder);
  516.     DEALLOCATE (BPtr,SIZE(BorderType));
  517.  END; (*IF*)
  518. END DelBorder;
  519. (*--------------------------------------*)
  520.  
  521. BEGIN
  522.  
  523.  IF (WPtr # NIL) AND (GPtr # NIL) AND (GPtr^.gadgetType # propGadget) THEN
  524.     DelBorder (GPtr^.gadgetRender);
  525.     GPtr^.gadgetRender := NIL;
  526.  END; (*IF*)
  527.  
  528. END DeleteBorder;
  529.  
  530. (*--------------------------------------------------------------------------*)
  531.  
  532. PROCEDURE DeleteGadget (VAR GPtr : GadgetPtr);
  533. (* Löschen eines Gadgets aus der Windowliste und aus dem Speicher.
  534.    Neuaufbau des Fensters muß selbst erledigt werden.
  535.    ACHTUNG! Das Gadget muß von diesem Modul erstellt worden sein,
  536.    sonst ist ein Absturz fast sicher! *)
  537.  
  538. VAR Pos          : INTEGER;
  539.  
  540. BEGIN
  541.  
  542.  IF (WPtr # NIL) AND (GPtr # NIL) THEN
  543.  
  544.     Pos := RemoveGadget (WPtr,GPtr);    (* Aus Liste entfernen *)
  545.  
  546.   (* Speicher freigeben: *)
  547.   (*---------------------*)
  548.  
  549.   (* Text *)
  550.     DeleteText (GPtr);
  551.  
  552.   (* Rahmen *)
  553.     IF (GPtr^.gadgetType # propGadget) THEN
  554.        DeleteBorder (GPtr);
  555.     END; (*IF*)
  556.  
  557.   (* Gadget *)
  558.     IF (GPtr^.gadgetType = strGadget) THEN
  559.        DEALLOCATE (GPtr,SIZE(StrGadgetType));
  560.     ELSIF (GPtr^.gadgetType = boolGadget) THEN
  561.        DEALLOCATE (GPtr,SIZE(BoolGadgetType));
  562.     ELSIF (GPtr^.gadgetType = propGadget) THEN
  563.        DEALLOCATE (GPtr,SIZE(PropGadgetType));
  564.     END; (*IF*)
  565.     GPtr := NIL;
  566.  
  567.  END; (*IF*)
  568.  
  569. END DeleteGadget;
  570.  
  571. (*--------------------------------------------------------------------------*)
  572.  
  573. PROCEDURE ReadStrGadget (    GPtr : GadgetPtr;
  574.                          VAR Str  : ARRAY OF CHAR);
  575. (* Liest das angegebenen StringGadget aus und gibt den Inhalt zurück *)
  576.  
  577. VAR SIPtr   : StringInfoPtr;
  578.     TextPtr : StrTypePtr;
  579.  
  580. BEGIN
  581.  
  582.  IF (GPtr^.gadgetType = strGadget) THEN
  583.     SIPtr := GPtr^.specialInfo;
  584.     TextPtr := SIPtr^.buffer;
  585.     Copy (Str,TextPtr^);
  586.  ELSE
  587.     Str := nul;
  588.  END; (*IF*)
  589.  
  590. END ReadStrGadget;
  591.  
  592. (*--------------------------------------------------------------------------*)
  593.  
  594. PROCEDURE SetStrGadget (GPtr       : GadgetPtr;
  595.                         Buffer     : ARRAY OF CHAR);
  596. (* Belegt den Inhalt eines StringGadgets mit der angegebenen Zeichenkette *)
  597.  
  598. VAR SIPtr   : StringInfoPtr;
  599.     TextPtr : StrTypePtr;
  600.  
  601. BEGIN
  602.  
  603.  IF (GPtr^.gadgetType = strGadget) AND (WPtr # NIL) THEN
  604.     SIPtr := GPtr^.specialInfo;
  605.     IF (stringCenter IN GPtr^.activation) THEN
  606.        SIPtr^.bufferPos := Length(Buffer) DIV 2;
  607.        SIPtr^.dispPos := SIPtr^.bufferPos - (SIPtr^.dispCount DIV 2);
  608.     ELSIF (stringRight IN GPtr^.activation) THEN
  609.        SIPtr^.bufferPos := Length(Buffer);
  610.        SIPtr^.dispPos := SIPtr^.bufferPos - SIPtr^.dispCount;
  611.     ELSE
  612.        SIPtr^.bufferPos := 0;
  613.        SIPtr^.dispPos := 0;
  614.     END; (*IF*)
  615.     TextPtr := SIPtr^.buffer;
  616.     Copy (TextPtr^,Buffer);
  617.     RefreshGadgets (GPtr,WPtr,NIL);
  618.  END; (*IF*)
  619.  
  620. END SetStrGadget;
  621.  
  622. (*--------------------------------------------------------------------------*)
  623.  
  624. PROCEDURE ReadLongint (    GPtr  : GadgetPtr;
  625.                        VAR Value : LONGINT);
  626. (* Liest den Inhalt eines LONGINT-String-Gadgets aus *)
  627.  
  628. VAR SIPtr   : StringInfoPtr;
  629.  
  630. BEGIN
  631.  
  632.  IF (GPtr^.gadgetType = strGadget) AND (longint IN GPtr^.activation) THEN
  633.     SIPtr := GPtr^.specialInfo;
  634.     Value := SIPtr^.longInt;
  635.  ELSE
  636.     Value := 0;
  637.  END; (*IF*)
  638.  
  639. END ReadLongint;
  640.  
  641. (*--------------------------------------------------------------------------*)
  642.  
  643. PROCEDURE SetLongint (GPtr  : GadgetPtr;
  644.                       Value : LONGINT);
  645. (* Setzt den Inhalt eines LONGINT-String-Gadgets auf den angegebenen Wert *)
  646.  
  647. VAR String : ARRAY [1..12] OF CHAR;
  648.     err    : BOOLEAN;
  649.     SIPtr  : StringInfoPtr;
  650.  
  651. BEGIN
  652.  
  653.  IF (GPtr^.gadgetType = strGadget) AND (longint IN GPtr^.activation) THEN
  654.     SIPtr := GPtr^.specialInfo;
  655.     SIPtr^.longInt := Value;
  656.     ValToStr (Value,TRUE,String,10,-11,nul,err);
  657.     SetStrGadget (GPtr,String);
  658.  END; (*IF*)
  659.  
  660. END SetLongint;
  661.  
  662. (*--------------------------------------------------------------------------*)
  663.  
  664. PROCEDURE ReadPropGadget (    GPtr    : GadgetPtr;
  665.                           VAR xValue  : CARDINAL;
  666.                           VAR yValue  : CARDINAL);
  667. (* Liest die Stellung eines Schiebereglers aus *)
  668.  
  669. VAR PInfoPtr : POINTER TO PropInfo;
  670.  
  671. BEGIN
  672.  
  673.  IF (GPtr^.gadgetType = propGadget) THEN
  674.      PInfoPtr := GPtr^.specialInfo;
  675.      WITH PInfoPtr^ DO
  676.        IF (freeHoriz IN flags) THEN
  677.         xValue := horizPot DIV horizBody;
  678.        ELSE
  679.         xValue := 0;
  680.        END; (*IF*)
  681.        IF (freeVert IN flags) THEN
  682.         yValue := vertPot DIV vertBody;
  683.        ELSE
  684.         yValue := 0;
  685.        END; (*IF*)
  686.      END; (*WITH*)
  687.  ELSE
  688.      xValue := 0; yValue := 0;
  689.  END; (*IF*)
  690.  
  691. END ReadPropGadget;
  692.  
  693. (*--------------------------------------------------------------------------*)
  694.  
  695. PROCEDURE SetPropGadget (GPtr    : GadgetPtr;
  696.                          xValue  : CARDINAL;
  697.                          yValue  : CARDINAL);
  698. (* Setzen eines Proportional-Gadgets auf einen bestimmten Wert *)
  699.  
  700. VAR PInfoPtr : POINTER TO PropInfo;
  701.     AnzV, AnzH : CARDINAL;
  702.     newVBody,newHBody : CARDINAL;
  703.  
  704. BEGIN
  705.  
  706.  IF (GPtr^.gadgetType = propGadget) AND (WPtr # NIL) THEN
  707.      PInfoPtr := GPtr^.specialInfo;
  708.      WITH PInfoPtr^ DO
  709.        IF (freeHoriz IN flags) THEN
  710.          IF (horizBody <= 1) THEN
  711.             AnzH := MaxPropSteps - 1;
  712.          ELSE
  713.             AnzH := MaxPropSteps DIV (horizBody - 1);
  714.          END; (*IF*)
  715.          newHBody := MaxPropSteps DIV (AnzH - 1);
  716.          horizPot := xValue * newHBody;
  717.        END; (*IF*)
  718.  
  719.        IF (freeVert IN flags) THEN
  720.          IF (vertBody <= 1) THEN
  721.             AnzV := MaxPropSteps - 1;
  722.          ELSE
  723.             AnzV := MaxPropSteps DIV (vertBody - 1);
  724.          END; (*IF*)
  725.          newVBody := MaxPropSteps DIV (AnzV - 1);
  726.          vertPot  := yValue * newVBody;
  727.        END; (*IF*)
  728.      END; (*WITH*)
  729.      RefreshGadgets (GPtr, WPtr, NIL);
  730.  END; (*IF*)
  731.  
  732. END SetPropGadget;
  733.  
  734. (*--------------------------------------------------------------------------*)
  735.  
  736. PROCEDURE ReadToggleSelect (    GPtr     : GadgetPtr;
  737.                             VAR Selected : BOOLEAN);
  738. (* Abfragen eines ToggleSelect-Boolean-Gadgets. *)
  739.  
  740. BEGIN
  741.  
  742.  IF (WPtr # NIL) AND (GPtr^.gadgetType = boolGadget) AND
  743.                      (toggleSelect IN GPtr^.activation) THEN
  744.     Selected := (selected IN GPtr^.flags);
  745.  END; (*IF*)
  746.  
  747. END ReadToggleSelect;
  748.  
  749. (*--------------------------------------------------------------------------*)
  750.  
  751. PROCEDURE SetToggleSelect (GPtr   : GadgetPtr;
  752.                            Select : BOOLEAN);
  753. (* Setzen eines ToggleSelect-Boolean-Gadgets. *)
  754.  
  755. BEGIN
  756.  
  757.  IF (WPtr # NIL) AND (GPtr^.gadgetType = boolGadget) AND
  758.                      (toggleSelect IN GPtr^.activation) THEN
  759.     IF (Select) AND NOT (selected IN GPtr^.flags) THEN
  760.        INCL (GPtr^.flags,selected);
  761.        RefreshGadgets (GPtr, WPtr, NIL);
  762.     ELSIF (NOT Select) AND (selected IN GPtr^.flags) THEN
  763.        EXCL (GPtr^.flags,selected);
  764.        RefreshGadgets (GPtr, WPtr, NIL);
  765.     END; (*IF*)
  766.  
  767.  END; (*IF*)
  768.  
  769. END SetToggleSelect;
  770.  
  771. (*--------------------------------------------------------------------------*)
  772.  
  773. BEGIN (* Initialisierung *)
  774.  
  775.  WPtr := NIL;
  776.  
  777. END Gadgets.
  778.